home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / Tickle-4.0 (tcl) / tcl / src / tclParse.c copy < prev    next >
Encoding:
Text File  |  1993-11-07  |  35.4 KB  |  1,308 lines  |  [TEXT/MPS ]
  1. #ifdef MPW
  2. #    pragma segment TCL_PARSE
  3. #endif
  4.  
  5. /* 
  6.  * tclParse.c --
  7.  *
  8.  *    This file contains a collection of procedures that are used
  9.  *    to parse Tcl commands or parts of commands (like quoted
  10.  *    strings or nested sub-commands).
  11.  *
  12.  * Copyright (c) 1987-1993 The Regents of the University of California.
  13.  * All rights reserved.
  14.  *
  15.  * Permission is hereby granted, without written agreement and without
  16.  * license or royalty fees, to use, copy, modify, and distribute this
  17.  * software and its documentation for any purpose, provided that the
  18.  * above copyright notice and the following two paragraphs appear in
  19.  * all copies of this software.
  20.  * 
  21.  * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  22.  * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  23.  * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  24.  * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  25.  *
  26.  * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  27.  * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  28.  * AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  29.  * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  30.  * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  31.  */
  32.  
  33. #ifndef lint
  34. static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclParse.c,v 1.35 93/08/18 16:07:16 ouster Exp $ SPRITE (Berkeley)";
  35. #endif
  36.  
  37. #include "tclInt.h"
  38.  
  39. /*
  40.  * The following table assigns a type to each character.  Only types
  41.  * meaningful to Tcl parsing are represented here.  The table indexes
  42.  * all 256 characters, with the negative ones first, then the positive
  43.  * ones.
  44.  */
  45.  
  46. char tclTypeTable[] = {
  47.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  48.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  49.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  50.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  51.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  52.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  53.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  54.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  55.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  56.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  57.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  58.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  59.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  60.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  61.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  62.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  63.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  64.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  65.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  66.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  67.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  68.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  69.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  70.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  71.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  72.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  73.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  74.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  75.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  76.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  77.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  78.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  79. /* Dividing line between positive and negative... */
  80.     TCL_COMMAND_END,   TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  81.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  82.     TCL_NORMAL,        TCL_SPACE,         TCL_COMMAND_END/*NL*/, TCL_SPACE,
  83.     TCL_SPACE,         TCL_COMMAND_END/*CR*/, TCL_NORMAL,    TCL_NORMAL,
  84.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  85.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  86.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  87.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  88.     TCL_SPACE,         TCL_NORMAL,        TCL_QUOTE,         TCL_NORMAL,
  89.     TCL_DOLLAR,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  90.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  91.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  92.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  93.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  94.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_COMMAND_END,
  95.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  96.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  97.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  98.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  99.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  100.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  101.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  102.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_OPEN_BRACKET,
  103.     TCL_BACKSLASH,     TCL_COMMAND_END,   TCL_NORMAL,        TCL_NORMAL,
  104.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  105.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  106.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  107.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  108.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  109.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  110.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_OPEN_BRACE,
  111.     TCL_NORMAL,        TCL_CLOSE_BRACE,   TCL_NORMAL,        TCL_NORMAL,
  112. };
  113.  
  114. /*
  115.  * Function prototypes for procedures local to this file:
  116.  */
  117.  
  118. static char *    QuoteEnd _ANSI_ARGS_((char *string, int term));
  119. static char *    VarNameEnd _ANSI_ARGS_((char *string));
  120.  
  121. /*
  122.  *----------------------------------------------------------------------
  123.  *
  124.  * Tcl_Backslash --
  125.  *
  126.  *    Figure out how to handle a backslash sequence.
  127.  *
  128.  * Results:
  129.  *    The return value is the character that should be substituted
  130.  *    in place of the backslash sequence that starts at src.  If
  131.  *    readPtr isn't NULL then it is filled in with a count of the
  132.  *    number of characters in the backslash sequence.
  133.  *
  134.  * Side effects:
  135.  *    None.
  136.  *
  137.  *----------------------------------------------------------------------
  138.  */
  139.  
  140. char
  141. Tcl_Backslash(src, readPtr)
  142.     char *src;            /* Points to the backslash character of
  143.                  * a backslash sequence. */
  144.     int *readPtr;        /* Fill in with number of characters read
  145.                  * from src, unless NULL. */
  146. {
  147.     register char *p = src+1;
  148.     char result;
  149.     int count;
  150.  
  151.     count = 2;
  152.  
  153.     switch (*p) {
  154.     case 'a':
  155.         result = 0x7;    /* Don't say '\a' here, since some compilers */
  156.         break;        /* don't support it. */
  157.     case 'b':
  158.         result = '\b';
  159.         break;
  160.     case 'f':
  161.         result = '\f';
  162.         break;
  163.     case 'n':
  164. #if defined(THINK_C) && defined(TCLAPPL)
  165. /* These translations are crazy due to the console! */
  166.         result = '\015';
  167. #else
  168.         result = '\n';
  169. #endif
  170.         break;
  171.     case 'r':
  172. #if defined(THINK_C) && defined(TCLAPPL)
  173. /* These translations are crazy due to the console! */
  174.         result = '\012';
  175. #else
  176.         result = '\r';
  177. #endif
  178.         break;
  179.     case 't':
  180.         result = '\t';
  181.         break;
  182.     case 'v':
  183.         result = '\v';
  184.         break;
  185.     case 'x':
  186.         if (isxdigit(UCHAR(p[1]))) {
  187.         char *end;
  188.  
  189.         result = strtoul(p+1, &end, 16);
  190.         count = end - src;
  191.         } else {
  192.         count = 2;
  193.         result = 'x';
  194.         }
  195.         break;
  196. #ifdef THINK_C
  197.     case '\r':
  198.     case '\n':
  199. #else
  200.     case '\n':
  201. #endif
  202.         do {
  203.         p++;
  204.         } while (isspace(UCHAR(*p)));
  205.         result = ' ';
  206.         count = p - src;
  207.         break;
  208.     case 0:
  209.         result = '\\';
  210.         count = 1;
  211.         break;
  212.     default:
  213.         if (isdigit(UCHAR(*p))) {
  214.         result = *p - '0';
  215.         p++;
  216.         if (!isdigit(UCHAR(*p))) {
  217.             break;
  218.         }
  219.         count = 3;
  220.         result = (result << 3) + (*p - '0');
  221.         p++;
  222.         if (!isdigit(UCHAR(*p))) {
  223.             break;
  224.         }
  225.         count = 4;
  226.         result = (result << 3) + (*p - '0');
  227.         break;
  228.         }
  229.         result = *p;
  230.         count = 2;
  231.         break;
  232.     }
  233.  
  234.     if (readPtr != NULL) {
  235.     *readPtr = count;
  236.     }
  237.     return result;
  238. }
  239.  
  240. /*
  241.  *--------------------------------------------------------------
  242.  *
  243.  * TclParseQuotes --
  244.  *
  245.  *    This procedure parses a double-quoted string such as a
  246.  *    quoted Tcl command argument or a quoted value in a Tcl
  247.  *    expression.  This procedure is also used to parse array
  248.  *    element names within parentheses, or anything else that
  249.  *    needs all the substitutions that happen in quotes.
  250.  *
  251.  * Results:
  252.  *    The return value is a standard Tcl result, which is
  253.  *    TCL_OK unless there was an error while parsing the
  254.  *    quoted string.  If an error occurs then interp->result
  255.  *    contains a standard error message.  *TermPtr is filled
  256.  *    in with the address of the character just after the
  257.  *    last one successfully processed;  this is usually the
  258.  *    character just after the matching close-quote.  The
  259.  *    fully-substituted contents of the quotes are stored in
  260.  *    standard fashion in *pvPtr, null-terminated with
  261.  *    pvPtr->next pointing to the terminating null character.
  262.  *
  263.  * Side effects:
  264.  *    The buffer space in pvPtr may be enlarged by calling its
  265.  *    expandProc.
  266.  *
  267.  *--------------------------------------------------------------
  268.  */
  269.  
  270. int
  271. TclParseQuotes(interp, string, termChar, flags, termPtr, pvPtr)
  272.     Tcl_Interp *interp;        /* Interpreter to use for nested command
  273.                  * evaluations and error messages. */
  274.     char *string;        /* Character just after opening double-
  275.                  * quote. */
  276.     int termChar;        /* Character that terminates "quoted" string
  277.                  * (usually double-quote, but sometimes
  278.                  * right-paren or something else). */
  279.     int flags;            /* Flags to pass to nested Tcl_Eval calls. */
  280.     char **termPtr;        /* Store address of terminating character
  281.                  * here. */
  282.     ParseValue *pvPtr;        /* Information about where to place
  283.                  * fully-substituted result of parse. */
  284. {
  285.     register char *src, *dst, c;
  286.  
  287.     src = string;
  288.     dst = pvPtr->next;
  289.  
  290.     while (1) {
  291.     if (dst == pvPtr->end) {
  292.         /*
  293.          * Target buffer space is about to run out.  Make more space.
  294.          */
  295.  
  296.         pvPtr->next = dst;
  297.         (*pvPtr->expandProc)(pvPtr, 1);
  298.         dst = pvPtr->next;
  299.     }
  300.  
  301.     c = *src;
  302.     src++;
  303.     if (c == termChar) {
  304.         *dst = '\0';
  305.         pvPtr->next = dst;
  306.         *termPtr = src;
  307.         return TCL_OK;
  308.     } else if (CHAR_TYPE(c) == TCL_NORMAL) {
  309.         copy:
  310.         *dst = c;
  311.         dst++;
  312.         continue;
  313.     } else if (c == '$') {
  314.         int length;
  315.         char *value;
  316.  
  317.         value = Tcl_ParseVar(interp, src-1, termPtr);
  318.         if (value == NULL) {
  319.         return TCL_ERROR;
  320.         }
  321.         src = *termPtr;
  322.         length = strlen(value);
  323.         if ((pvPtr->end - dst) <= length) {
  324.         pvPtr->next = dst;
  325.         (*pvPtr->expandProc)(pvPtr, length);
  326.         dst = pvPtr->next;
  327.         }
  328.         strcpy(dst, value);
  329.         dst += length;
  330.         continue;
  331.     } else if (c == '[') {
  332.         int result;
  333.  
  334.         pvPtr->next = dst;
  335.         result = TclParseNestedCmd(interp, src, flags, termPtr, pvPtr);
  336.         if (result != TCL_OK) {
  337.         return result;
  338.         }
  339.         src = *termPtr;
  340.         dst = pvPtr->next;
  341.         continue;
  342.     } else if (c == '\\') {
  343.         int numRead;
  344.  
  345.         src--;
  346.         *dst = Tcl_Backslash(src, &numRead);
  347.         dst++;
  348.         src += numRead;
  349.         continue;
  350.     } else if (c == '\0') {
  351.         Tcl_ResetResult(interp);
  352.         sprintf(interp->result, "missing %c", termChar);
  353.         *termPtr = string-1;
  354.         return TCL_ERROR;
  355.     } else {
  356.         goto copy;
  357.     }
  358.     }
  359. }
  360.  
  361. /*
  362.  *--------------------------------------------------------------
  363.  *
  364.  * TclParseNestedCmd --
  365.  *
  366.  *    This procedure parses a nested Tcl command between
  367.  *    brackets, returning the result of the command.
  368.  *
  369.  * Results:
  370.  *    The return value is a standard Tcl result, which is
  371.  *    TCL_OK unless there was an error while executing the
  372.  *    nested command.  If an error occurs then interp->result
  373.  *    contains a standard error message.  *TermPtr is filled
  374.  *    in with the address of the character just after the
  375.  *    last one processed;  this is usually the character just
  376.  *    after the matching close-bracket, or the null character
  377.  *    at the end of the string if the close-bracket was missing
  378.  *    (a missing close bracket is an error).  The result returned
  379.  *    by the command is stored in standard fashion in *pvPtr,
  380.  *    null-terminated, with pvPtr->next pointing to the null
  381.  *    character.
  382.  *
  383.  * Side effects:
  384.  *    The storage space at *pvPtr may be expanded.
  385.  *
  386.  *--------------------------------------------------------------
  387.  */
  388.  
  389. int
  390. TclParseNestedCmd(interp, string, flags, termPtr, pvPtr)
  391.     Tcl_Interp *interp;        /* Interpreter to use for nested command
  392.                  * evaluations and error messages. */
  393.     char *string;        /* Character just after opening bracket. */
  394.     int flags;            /* Flags to pass to nested Tcl_Eval. */
  395.     char **termPtr;        /* Store address of terminating character
  396.                  * here. */
  397.     register ParseValue *pvPtr;    /* Information about where to place
  398.                  * result of command. */
  399. {
  400.     int result, length, shortfall;
  401.     Interp *iPtr = (Interp *) interp;
  402.  
  403.     iPtr->evalFlags = flags | TCL_BRACKET_TERM;
  404.     result = Tcl_Eval(interp, string);
  405.     *termPtr = iPtr->termPtr;
  406.     if (result != TCL_OK) {
  407.     /*
  408.      * The increment below results in slightly cleaner message in
  409.      * the errorInfo variable (the close-bracket will appear).
  410.      */
  411.  
  412.     if (**termPtr == ']') {
  413.         *termPtr += 1;
  414.     }
  415.     return result;
  416.     }
  417.     (*termPtr) += 1;
  418.     length = strlen(iPtr->result);
  419.     shortfall = length + 1 - (pvPtr->end - pvPtr->next);
  420.     if (shortfall > 0) {
  421.     (*pvPtr->expandProc)(pvPtr, shortfall);
  422.     }
  423.     strcpy(pvPtr->next, iPtr->result);
  424.     pvPtr->next += length;
  425.     Tcl_FreeResult(iPtr);
  426.     iPtr->result = iPtr->resultSpace;
  427.     iPtr->resultSpace[0] = '\0';
  428.     return TCL_OK;
  429. }
  430.  
  431. /*
  432.  *--------------------------------------------------------------
  433.  *
  434.  * TclParseBraces --
  435.  *
  436.  *    This procedure scans the information between matching
  437.  *    curly braces.
  438.  *
  439.  * Results:
  440.  *    The return value is a standard Tcl result, which is
  441.  *    TCL_OK unless there was an error while parsing string.
  442.  *    If an error occurs then interp->result contains a
  443.  *    standard error message.  *TermPtr is filled
  444.  *    in with the address of the character just after the
  445.  *    last one successfully processed;  this is usually the
  446.  *    character just after the matching close-brace.  The
  447.  *    information between curly braces is stored in standard
  448.  *    fashion in *pvPtr, null-terminated with pvPtr->next
  449.  *    pointing to the terminating null character.
  450.  *
  451.  * Side effects:
  452.  *    The storage space at *pvPtr may be expanded.
  453.  *
  454.  *--------------------------------------------------------------
  455.  */
  456.  
  457. int
  458. TclParseBraces(interp, string, termPtr, pvPtr)
  459.     Tcl_Interp *interp;        /* Interpreter to use for nested command
  460.                  * evaluations and error messages. */
  461.     char *string;        /* Character just after opening bracket. */
  462.     char **termPtr;        /* Store address of terminating character
  463.                  * here. */
  464.     register ParseValue *pvPtr;    /* Information about where to place
  465.                  * result of command. */
  466. {
  467.     int level;
  468.     register char *src, *dst, *end;
  469.     register char c;
  470.  
  471.     src = string;
  472.     dst = pvPtr->next;
  473.     end = pvPtr->end;
  474.     level = 1;
  475.  
  476.     /*
  477.      * Copy the characters one at a time to the result area, stopping
  478.      * when the matching close-brace is found.
  479.      */
  480.  
  481.     while (1) {
  482.     c = *src;
  483.     src++;
  484.     if (dst == end) {
  485.         pvPtr->next = dst;
  486.         (*pvPtr->expandProc)(pvPtr, 20);
  487.         dst = pvPtr->next;
  488.         end = pvPtr->end;
  489.     }
  490.     *dst = c;
  491.     dst++;
  492.     if (CHAR_TYPE(c) == TCL_NORMAL) {
  493.         continue;
  494.     } else if (c == '{') {
  495.         level++;
  496.     } else if (c == '}') {
  497.         level--;
  498.         if (level == 0) {
  499.         dst--;            /* Don't copy the last close brace. */
  500.         break;
  501.         }
  502.     } else if (c == '\\') {
  503.         int count;
  504.  
  505.         /*
  506.          * Must always squish out backslash-newlines, even when in
  507.          * braces.  This is needed so that this sequence can appear
  508.          * anywhere in a command, such as the middle of an expression.
  509.          */
  510.  
  511. #ifdef THINK_C
  512.         if (*src == '\r' || *src == '\n') {
  513. #else
  514.         if (*src == '\n') {
  515. #endif
  516.         dst[-1] = Tcl_Backslash(src-1, &count);
  517.         src += count - 1;
  518.         } else {
  519.         (void) Tcl_Backslash(src-1, &count);
  520.         while (count > 1) {
  521.                     if (dst == end) {
  522.                         pvPtr->next = dst;
  523.                         (*pvPtr->expandProc)(pvPtr, 20);
  524.                         dst = pvPtr->next;
  525.                         end = pvPtr->end;
  526.                     }
  527.             *dst = *src;
  528.             dst++;
  529.             src++;
  530.             count--;
  531.         }
  532.         }
  533.     } else if (c == '\0') {
  534.         Tcl_SetResult(interp, "missing close-brace", TCL_STATIC);
  535.         *termPtr = string-1;
  536.         return TCL_ERROR;
  537.     }
  538.     }
  539.  
  540.     *dst = '\0';
  541.     pvPtr->next = dst;
  542.     *termPtr = src;
  543.     return TCL_OK;
  544. }
  545.  
  546. /*
  547.  *--------------------------------------------------------------
  548.  *
  549.  * TclParseWords --
  550.  *
  551.  *    This procedure parses one or more words from a command
  552.  *    string and creates argv-style pointers to fully-substituted
  553.  *    copies of those words.
  554.  *
  555.  * Results:
  556.  *    The return value is a standard Tcl result.
  557.  *    
  558.  *    *argcPtr is modified to hold a count of the number of words
  559.  *    successfully parsed, which may be 0.  At most maxWords words
  560.  *    will be parsed.  If 0 <= *argcPtr < maxWords then it
  561.  *    means that a command separator was seen.  If *argcPtr
  562.  *    is maxWords then it means that a command separator was
  563.  *    not seen yet.
  564.  *
  565.  *    *TermPtr is filled in with the address of the character
  566.  *    just after the last one successfully processed in the
  567.  *    last word.  This is either the command terminator (if
  568.  *    *argcPtr < maxWords), the character just after the last
  569.  *    one in a word (if *argcPtr is maxWords), or the vicinity
  570.  *    of an error (if the result is not TCL_OK).
  571.  *    
  572.  *    The pointers at *argv are filled in with pointers to the
  573.  *    fully-substituted words, and the actual contents of the
  574.  *    words are copied to the buffer at pvPtr.
  575.  *
  576.  *    If an error occurrs then an error message is left in
  577.  *    interp->result and the information at *argv, *argcPtr,
  578.  *    and *pvPtr may be incomplete.
  579.  *
  580.  * Side effects:
  581.  *    The buffer space in pvPtr may be enlarged by calling its
  582.  *    expandProc.
  583.  *
  584.  *--------------------------------------------------------------
  585.  */
  586.  
  587. int
  588. TclParseWords(interp, string, flags, maxWords, termPtr, argcPtr, argv, pvPtr)
  589.     Tcl_Interp *interp;        /* Interpreter to use for nested command
  590.                  * evaluations and error messages. */
  591.     char *string;        /* First character of word. */
  592.     int flags;            /* Flags to control parsing (same values as
  593.                  * passed to Tcl_Eval). */
  594.     int maxWords;        /* Maximum number of words to parse. */
  595.     char **termPtr;        /* Store address of terminating character
  596.                  * here. */
  597.     int *argcPtr;        /* Filled in with actual number of words
  598.                  * parsed. */
  599.     char **argv;        /* Store addresses of individual words here. */
  600.     register ParseValue *pvPtr;    /* Information about where to place
  601.                  * fully-substituted word. */
  602. {
  603.     register char *src, *dst;
  604.     register char c;
  605.     int type, result, argc;
  606.     char *oldBuffer;        /* Used to detect when pvPtr's buffer gets
  607.                  * reallocated, so we can adjust all of the
  608.                  * argv pointers. */
  609.  
  610.     src = string;
  611.     oldBuffer = pvPtr->buffer;
  612.     dst = pvPtr->next;
  613.     for (argc = 0; argc < maxWords; argc++) {
  614.     argv[argc] = dst;
  615.  
  616.     /*
  617.      * Skip leading space.
  618.      */
  619.     
  620.     skipSpace:
  621.     c = *src;
  622.     type = CHAR_TYPE(c);
  623.     while (type == TCL_SPACE) {
  624.         src++;
  625.         c = *src;
  626.         type = CHAR_TYPE(c);
  627.     }
  628.     
  629.     /*
  630.      * Handle the normal case (i.e. no leading double-quote or brace).
  631.      */
  632.  
  633.     if (type == TCL_NORMAL) {
  634.         normalArg:
  635.         while (1) {
  636.         if (dst == pvPtr->end) {
  637.             /*
  638.              * Target buffer space is about to run out.  Make
  639.              * more space.
  640.              */
  641.     
  642.             pvPtr->next = dst;
  643.             (*pvPtr->expandProc)(pvPtr, 1);
  644.             dst = pvPtr->next;
  645.         }
  646.     
  647.         if (type == TCL_NORMAL) {
  648.             copy:
  649.             *dst = c;
  650.             dst++;
  651.             src++;
  652.         } else if (type == TCL_SPACE) {
  653.             goto wordEnd;
  654.         } else if (type == TCL_DOLLAR) {
  655.             int length;
  656.             char *value;
  657.     
  658.             value = Tcl_ParseVar(interp, src, termPtr);
  659.             if (value == NULL) {
  660.             return TCL_ERROR;
  661.             }
  662.             src = *termPtr;
  663.             length = strlen(value);
  664.             if ((pvPtr->end - dst) <= length) {
  665.             pvPtr->next = dst;
  666.             (*pvPtr->expandProc)(pvPtr, length);
  667.             dst = pvPtr->next;
  668.             }
  669.             strcpy(dst, value);
  670.             dst += length;
  671.         } else if (type == TCL_COMMAND_END) {
  672.             if ((c == ']') && !(flags & TCL_BRACKET_TERM)) {
  673.             goto copy;
  674.             }
  675.  
  676.             /*
  677.              * End of command;  simulate a word-end first, so
  678.              * that the end-of-command can be processed as the
  679.              * first thing in a new word.
  680.              */
  681.  
  682.             goto wordEnd;
  683.         } else if (type == TCL_OPEN_BRACKET) {
  684.             pvPtr->next = dst;
  685.             result = TclParseNestedCmd(interp, src+1, flags, termPtr,
  686.                 pvPtr);
  687.             if (result != TCL_OK) {
  688.             return result;
  689.             }
  690.             src = *termPtr;
  691.             dst = pvPtr->next;
  692.         } else if (type == TCL_BACKSLASH) {
  693.             int numRead;
  694.     
  695.             *dst = Tcl_Backslash(src, &numRead);
  696.  
  697.             /*
  698.              * The following special check allows a backslash-newline
  699.              * to be treated as a word-separator, as if the backslash
  700.              * and newline had been collapsed before command parsing
  701.              * began.
  702.              */
  703.  
  704. #ifdef THINK_C
  705.             if (src[1] == '\r' || src[1] == '\n') {
  706. #else
  707.             if (src[1] == '\n') {
  708. #endif
  709.             src += numRead;
  710.             goto wordEnd;
  711.             }
  712.             src += numRead;
  713.             dst++;
  714.         } else {
  715.             goto copy;
  716.         }
  717.         c = *src;
  718.         type = CHAR_TYPE(c);
  719.         }
  720.     } else {
  721.     
  722.         /*
  723.          * Check for the end of the command.
  724.          */
  725.     
  726.         if (type == TCL_COMMAND_END) {
  727.         if (flags & TCL_BRACKET_TERM) {
  728.             if (c == '\0') {
  729.             Tcl_SetResult(interp, "missing close-bracket",
  730.                 TCL_STATIC);
  731.             return TCL_ERROR;
  732.             }
  733.         } else {
  734.             if (c == ']') {
  735.             goto normalArg;
  736.             }
  737.         }
  738.         goto done;
  739.         }
  740.     
  741.         /*
  742.          * Now handle the special cases: open braces, double-quotes,
  743.          * and backslash-newline.
  744.          */
  745.  
  746.         pvPtr->next = dst;
  747.         if (type == TCL_QUOTE) {
  748.         result = TclParseQuotes(interp, src+1, '"', flags,
  749.             termPtr, pvPtr);
  750.         } else if (type == TCL_OPEN_BRACE) {
  751.         result = TclParseBraces(interp, src+1, termPtr, pvPtr);
  752. #ifdef THINK_C
  753.         } else if ((type == TCL_BACKSLASH) && (src[1] == '\r' || src[1] == '\n')) {
  754. #else
  755.         } else if ((type == TCL_BACKSLASH) && (src[1] == '\n')) {
  756. #endif
  757.         /*
  758.          * This code is needed so that a backslash-newline at the
  759.          * very beginning of a word is treated as part of the white
  760.          * space between words and not as a space within the word.
  761.          */
  762.  
  763.         src += 2;
  764.         goto skipSpace;
  765.         } else {
  766.         goto normalArg;
  767.         }
  768.         if (result != TCL_OK) {
  769.         return result;
  770.         }
  771.     
  772.         /*
  773.          * Back from quotes or braces;  make sure that the terminating
  774.          * character was the end of the word.  Have to be careful here
  775.          * to handle continuation lines (i.e. lines ending in backslash).
  776.          */
  777.     
  778.         c = **termPtr;
  779. #ifdef THINK_C
  780.         if ((c == '\\') && ((*termPtr)[1] == '\r' || (*termPtr)[1] == '\n')) {
  781. #else
  782.         if ((c == '\\') && ((*termPtr)[1] == '\n')) {
  783. #endif
  784.         c = (*termPtr)[2];
  785.         }
  786.         type = CHAR_TYPE(c);
  787.         if ((type != TCL_SPACE) && (type != TCL_COMMAND_END)) {
  788.         if (*src == '"') {
  789.             Tcl_SetResult(interp, "extra characters after close-quote",
  790.                 TCL_STATIC);
  791.         } else {
  792.             Tcl_SetResult(interp, "extra characters after close-brace",
  793.                 TCL_STATIC);
  794.         }
  795.         return TCL_ERROR;
  796.         }
  797.         src = *termPtr;
  798.         dst = pvPtr->next;
  799.  
  800.     }
  801.  
  802.     /*
  803.      * We're at the end of a word, so add a null terminator.  Then
  804.      * see if the buffer was re-allocated during this word.  If so,
  805.      * update all of the argv pointers.
  806.      */
  807.  
  808.     wordEnd:
  809.     *dst = '\0';
  810.     dst++;
  811.     if (oldBuffer != pvPtr->buffer) {
  812.         int i;
  813.  
  814.         for (i = 0; i <= argc; i++) {
  815.         argv[i] = pvPtr->buffer + (argv[i] - oldBuffer);
  816.         }
  817.         oldBuffer = pvPtr->buffer;
  818.     }
  819.     }
  820.  
  821.     done:
  822.     pvPtr->next = dst;
  823.     *termPtr = src;
  824.     *argcPtr = argc;
  825.     return TCL_OK;
  826. }
  827.  
  828. /*
  829.  *--------------------------------------------------------------
  830.  *
  831.  * TclExpandParseValue --
  832.  *
  833.  *    This procedure is commonly used as the value of the
  834.  *    expandProc in a ParseValue.  It uses malloc to allocate
  835.  *    more space for the result of a parse.
  836.  *
  837.  * Results:
  838.  *    The buffer space in *pvPtr is reallocated to something
  839.  *    larger, and if pvPtr->clientData is non-zero the old
  840.  *    buffer is freed.  Information is copied from the old
  841.  *    buffer to the new one.
  842.  *
  843.  * Side effects:
  844.  *    None.
  845.  *
  846.  *--------------------------------------------------------------
  847.  */
  848.  
  849. void
  850. TclExpandParseValue(pvPtr, needed)
  851.     register ParseValue *pvPtr;        /* Information about buffer that
  852.                      * must be expanded.  If the clientData
  853.                      * in the structure is non-zero, it
  854.                      * means that the current buffer is
  855.                      * dynamically allocated. */
  856.     int needed;                /* Minimum amount of additional space
  857.                      * to allocate. */
  858. {
  859.     int newSpace;
  860.     char *new;
  861.  
  862.     /*
  863.      * Either double the size of the buffer or add enough new space
  864.      * to meet the demand, whichever produces a larger new buffer.
  865.      */
  866.  
  867.     newSpace = (pvPtr->end - pvPtr->buffer) + 1;
  868.     if (newSpace < needed) {
  869.     newSpace += needed;
  870.     } else {
  871.     newSpace += newSpace;
  872.     }
  873.     new = (char *) ckalloc((unsigned) newSpace);
  874.  
  875.     /*
  876.      * Copy from old buffer to new, free old buffer if needed, and
  877.      * mark new buffer as malloc-ed.
  878.      */
  879.  
  880.     memcpy((VOID *) new, (VOID *) pvPtr->buffer, pvPtr->next - pvPtr->buffer);
  881.     pvPtr->next = new + (pvPtr->next - pvPtr->buffer);
  882.     if (pvPtr->clientData != 0) {
  883.     ckfree(pvPtr->buffer);
  884.     }
  885.     pvPtr->buffer = new;
  886.     pvPtr->end = new + newSpace - 1;
  887.     pvPtr->clientData = (ClientData) 1;
  888. }
  889.  
  890. /*
  891.  *----------------------------------------------------------------------
  892.  *
  893.  * TclWordEnd --
  894.  *
  895.  *    Given a pointer into a Tcl command, find the end of the next
  896.  *    word of the command.
  897.  *
  898.  * Results:
  899.  *    The return value is a pointer to the last character that's part
  900.  *    of the word pointed to by "start".  If the word doesn't end
  901.  *    properly within the string then the return value is the address
  902.  *    of the null character at the end of the string.
  903.  *
  904.  * Side effects:
  905.  *    None.
  906.  *
  907.  *----------------------------------------------------------------------
  908.  */
  909.  
  910. char *
  911. TclWordEnd(start, nested)
  912.     char *start;        /* Beginning of a word of a Tcl command. */
  913.     int nested;            /* Zero means this is a top-level command.
  914.                  * One means this is a nested command (close
  915.                  * brace is a word terminator). */
  916. {
  917.     register char *p;
  918.     int count;
  919.  
  920.     /*
  921.      * Skip leading white space (backslash-newline must be treated like
  922.      * white-space, except that it better not be the last thing in the
  923.      * command).
  924.      */
  925.  
  926.     for (p = start; ; p++) {
  927.     if (isspace(UCHAR(*p))) {
  928.         continue;
  929.     }
  930. #ifdef THINK_C
  931.     if ((p[0] == '\\') && (p[1] == '\r' || p[1] == '\n')) {
  932. #else
  933.     if ((p[0] == '\\') && (p[1] == '\n')) {
  934. #endif
  935.         if (p[2] == 0) {
  936.         return p+2;
  937.         }
  938.         continue;
  939.     }
  940.     break;
  941.     }
  942.  
  943.     /*
  944.      * Handle words beginning with a double-quote or a brace.
  945.      */
  946.  
  947.     if (*p == '"') {
  948.     p = QuoteEnd(p+1, '"');
  949.     if (*p == 0) {
  950.         return p;
  951.     }
  952.     p++;
  953.     } else if (*p == '{') {
  954.     int braces = 1;
  955.     while (braces != 0) {
  956.         p++;
  957.         while (*p == '\\') {
  958.         (void) Tcl_Backslash(p, &count);
  959.         p += count;
  960.         }
  961.         if (*p == '}') {
  962.         braces--;
  963.         } else if (*p == '{') {
  964.         braces++;
  965.         } else if (*p == 0) {
  966.         return p;
  967.         }
  968.     }
  969.     p++;
  970.     }
  971.  
  972.     /*
  973.      * Handle words that don't start with a brace or double-quote.
  974.      * This code is also invoked if the word starts with a brace or
  975.      * double-quote and there is garbage after the closing brace or
  976.      * quote.  This is an error as far as Tcl_Eval is concerned, but
  977.      * for here the garbage is treated as part of the word.
  978.      */
  979.  
  980.     while (1) {
  981.     if (*p == '[') {
  982.         for (p++; *p != ']'; p++) {
  983.         p = TclWordEnd(p, 1);
  984.         if (*p == 0) {
  985.             return p;
  986.         }
  987.         }
  988.         p++;
  989.     } else if (*p == '\\') {
  990.         (void) Tcl_Backslash(p, &count);
  991.         p += count;
  992. #ifdef THINK_C
  993.         if ((*p == 0) && (count == 2) && (p[-1] == '\r' || p[-1] == '\n')) {
  994. #else
  995.         if ((*p == 0) && (count == 2) && (p[-1] == '\n')) {
  996. #endif
  997.         return p;
  998.         }
  999.     } else if (*p == '$') {
  1000.         p = VarNameEnd(p);
  1001.         if (*p == 0) {
  1002.         return p;
  1003.         }
  1004.         p++;
  1005.     } else if (*p == ';') {
  1006.         /*
  1007.          * Include the semi-colon in the word that is returned.
  1008.          */
  1009.  
  1010.         return p;
  1011.     } else if (isspace(UCHAR(*p))) {
  1012.         return p-1;
  1013.     } else if ((*p == ']') && nested) {
  1014.         return p-1;
  1015.     } else if (*p == 0) {
  1016.         if (nested) {
  1017.         /*
  1018.          * Nested commands can't end because of the end of the
  1019.          * string.
  1020.          */
  1021.         return p;
  1022.         }
  1023.         return p-1;
  1024.     } else {
  1025.         p++;
  1026.     }
  1027.     }
  1028. }
  1029.  
  1030. /*
  1031.  *----------------------------------------------------------------------
  1032.  *
  1033.  * QuoteEnd --
  1034.  *
  1035.  *    Given a pointer to a string that obeys the parsing conventions
  1036.  *    for quoted things in Tcl, find the end of that quoted thing.
  1037.  *    The actual thing may be a quoted argument or a parenthesized
  1038.  *    index name.
  1039.  *
  1040.  * Results:
  1041.  *    The return value is a pointer to the last character that is
  1042.  *    part of the quoted string (i.e the character that's equal to
  1043.  *    term).  If the quoted string doesn't terminate properly then
  1044.  *    the return value is a pointer to the null character at the
  1045.  *    end of the string.
  1046.  *
  1047.  * Side effects:
  1048.  *    None.
  1049.  *
  1050.  *----------------------------------------------------------------------
  1051.  */
  1052.  
  1053. static char *
  1054. QuoteEnd(string, term)
  1055.     char *string;        /* Pointer to character just after opening
  1056.                  * "quote". */
  1057.     int term;            /* This character will terminate the
  1058.                  * quoted string (e.g. '"' or ')'). */
  1059. {
  1060.     register char *p = string;
  1061.     int count;
  1062.  
  1063.     while (*p != term) {
  1064.     if (*p == '\\') {
  1065.         (void) Tcl_Backslash(p, &count);
  1066.         p += count;
  1067.     } else if (*p == '[') {
  1068.         for (p++; *p != ']'; p++) {
  1069.         p = TclWordEnd(p, 1);
  1070.         if (*p == 0) {
  1071.             return p;
  1072.         }
  1073.         }
  1074.         p++;
  1075.     } else if (*p == '$') {
  1076.         p = VarNameEnd(p);
  1077.         if (*p == 0) {
  1078.         return p;
  1079.         }
  1080.         p++;
  1081.     } else if (*p == 0) {
  1082.         return p;
  1083.     } else {
  1084.         p++;
  1085.     }
  1086.     }
  1087.     return p-1;
  1088. }
  1089.  
  1090. /*
  1091.  *----------------------------------------------------------------------
  1092.  *
  1093.  * VarNameEnd --
  1094.  *
  1095.  *    Given a pointer to a variable reference using $-notation, find
  1096.  *    the end of the variable name spec.
  1097.  *
  1098.  * Results:
  1099.  *    The return value is a pointer to the last character that
  1100.  *    is part of the variable name.  If the variable name doesn't
  1101.  *    terminate properly then the return value is a pointer to the
  1102.  *    null character at the end of the string.
  1103.  *
  1104.  * Side effects:
  1105.  *    None.
  1106.  *
  1107.  *----------------------------------------------------------------------
  1108.  */
  1109.  
  1110. static char *
  1111. VarNameEnd(string)
  1112.     char *string;        /* Pointer to dollar-sign character. */
  1113. {
  1114.     register char *p = string+1;
  1115.  
  1116.     if (*p == '{') {
  1117.     for (p++; (*p != '}') && (*p != 0); p++) {
  1118.         /* Empty loop body. */
  1119.     }
  1120.     return p;
  1121.     }
  1122.     while (isalnum(UCHAR(*p)) || (*p == '_')) {
  1123.     p++;
  1124.     }
  1125.     if ((*p == '(') && (p != string+1)) {
  1126.     return QuoteEnd(p+1, ')');
  1127.     }
  1128.     return p-1;
  1129. }
  1130.  
  1131. /*
  1132.  *----------------------------------------------------------------------
  1133.  *
  1134.  * Tcl_ParseVar --
  1135.  *
  1136.  *    Given a string starting with a $ sign, parse off a variable
  1137.  *    name and return its value.
  1138.  *
  1139.  * Results:
  1140.  *    The return value is the contents of the variable given by
  1141.  *    the leading characters of string.  If termPtr isn't NULL,
  1142.  *    *termPtr gets filled in with the address of the character
  1143.  *    just after the last one in the variable specifier.  If the
  1144.  *    variable doesn't exist, then the return value is NULL and
  1145.  *    an error message will be left in interp->result.
  1146.  *
  1147.  * Side effects:
  1148.  *    None.
  1149.  *
  1150.  *----------------------------------------------------------------------
  1151.  */
  1152.  
  1153. char *
  1154. Tcl_ParseVar(interp, string, termPtr)
  1155.     Tcl_Interp *interp;            /* Context for looking up variable. */
  1156.     register char *string;        /* String containing variable name.
  1157.                      * First character must be "$". */
  1158.     char **termPtr;            /* If non-NULL, points to word to fill
  1159.                      * in with character just after last
  1160.                      * one in the variable specifier. */
  1161.  
  1162. {
  1163.     char *name1, *name1End, c, *result;
  1164.     register char *name2;
  1165. #define NUM_CHARS 200
  1166.     char copyStorage[NUM_CHARS];
  1167.     ParseValue pv;
  1168.  
  1169.     /*
  1170.      * There are three cases:
  1171.      * 1. The $ sign is followed by an open curly brace.  Then the variable
  1172.      *    name is everything up to the next close curly brace, and the
  1173.      *    variable is a scalar variable.
  1174.      * 2. The $ sign is not followed by an open curly brace.  Then the
  1175.      *    variable name is everything up to the next character that isn't
  1176.      *    a letter, digit, or underscore.  If the following character is an
  1177.      *    open parenthesis, then the information between parentheses is
  1178.      *    the array element name, which can include any of the substitutions
  1179.      *    permissible between quotes.
  1180.      * 3. The $ sign is followed by something that isn't a letter, digit,
  1181.      *    or underscore:  in this case, there is no variable name, and "$"
  1182.      *    is returned.
  1183.      */
  1184.  
  1185.     name2 = NULL;
  1186.     string++;
  1187.     if (*string == '{') {
  1188.     string++;
  1189.     name1 = string;
  1190.     while (*string != '}') {
  1191.         if (*string == 0) {
  1192.         Tcl_SetResult(interp, "missing close-brace for variable name",
  1193.             TCL_STATIC);
  1194.         if (termPtr != 0) {
  1195.             *termPtr = string;
  1196.         }
  1197.         return NULL;
  1198.         }
  1199.         string++;
  1200.     }
  1201.     name1End = string;
  1202.     string++;
  1203.     } else {
  1204.     name1 = string;
  1205.     while (isalnum(UCHAR(*string)) || (*string == '_')) {
  1206.         string++;
  1207.     }
  1208.     if (string == name1) {
  1209.         if (termPtr != 0) {
  1210.         *termPtr = string;
  1211.         }
  1212.         return "$";
  1213.     }
  1214.     name1End = string;
  1215.     if (*string == '(') {
  1216.         char *end;
  1217.  
  1218.         /*
  1219.          * Perform substitutions on the array element name, just as
  1220.          * is done for quotes.
  1221.          */
  1222.  
  1223.         pv.buffer = pv.next = copyStorage;
  1224.         pv.end = copyStorage + NUM_CHARS - 1;
  1225.         pv.expandProc = TclExpandParseValue;
  1226.         pv.clientData = (ClientData) NULL;
  1227.         if (TclParseQuotes(interp, string+1, ')', 0, &end, &pv)
  1228.             != TCL_OK) {
  1229.         char msg[100];
  1230.         sprintf(msg, "%c    (parsing index for array \"%.*s\")",
  1231. #if defined(THINK_C) && defined(TCLAPPL)
  1232.             '\r',
  1233. #else
  1234.             '\n',
  1235. #endif
  1236.             string-name1, name1);
  1237.         Tcl_AddErrorInfo(interp, msg);
  1238.         result = NULL;
  1239.         name2 = pv.buffer;
  1240.         if (termPtr != 0) {
  1241.             *termPtr = end;
  1242.         }
  1243.         goto done;
  1244.         }
  1245.         Tcl_ResetResult(interp);
  1246.         string = end;
  1247.         name2 = pv.buffer;
  1248.     }
  1249.     }
  1250.     if (termPtr != 0) {
  1251.     *termPtr = string;
  1252.     }
  1253.  
  1254.     if (((Interp *) interp)->noEval) {
  1255.     return "";
  1256.     }
  1257.     c = *name1End;
  1258.     *name1End = 0;
  1259.     result = Tcl_GetVar2(interp, name1, name2, TCL_LEAVE_ERR_MSG);
  1260.     *name1End = c;
  1261.  
  1262.     done:
  1263.     if ((name2 != NULL) && (pv.buffer != copyStorage)) {
  1264.     ckfree(pv.buffer);
  1265.     }
  1266.     return result;
  1267. }
  1268.  
  1269. /*
  1270.  *----------------------------------------------------------------------
  1271.  *
  1272.  * Tcl_CommandComplete --
  1273.  *
  1274.  *    Given a partial or complete Tcl command, this procedure
  1275.  *    determines whether the command is complete in the sense
  1276.  *    of having matched braces and quotes and brackets.
  1277.  *
  1278.  * Results:
  1279.  *    1 is returned if the command is complete, 0 otherwise.
  1280.  *
  1281.  * Side effects:
  1282.  *    None.
  1283.  *
  1284.  *----------------------------------------------------------------------
  1285.  */
  1286.  
  1287. int
  1288. Tcl_CommandComplete(cmd)
  1289.     char *cmd;            /* Command to check. */
  1290. {
  1291.     register char *p = cmd;
  1292.  
  1293.     p = cmd;
  1294.     while (1) {
  1295.     while (isspace(UCHAR(*p))) {
  1296.         p++;
  1297.     }
  1298.     if (*p == 0) {
  1299.         return 1;
  1300.     }
  1301.     p = TclWordEnd(p, 0);
  1302.     if (*p == 0) {
  1303.         return 0;
  1304.     }
  1305.     p++;
  1306.     }
  1307. }
  1308.